perm filename QPRN.SAI[1,BGB] blob sn#015998 filedate 1972-12-06 generic text, type T, neo UTF8
00100	BEGIN "QPRN"
00200		REQUIRE "ABBREV[SYS,BGB]" SOURCE_FILE;
00300		ITG R,C,QQ,COL,PTR;
00400		SAFE ITG ARRAY Q[0:1000];
00500		SAFE ITG ARRAY X[0:7,0:63];
00600	
00700	SUBR OSTR(STRING S);⊂ OUTSTR(S);OUT(2,S);⊃;
00800	
00900	SUBR PROW(ITG I);
01000	BEGIN
01100		ITG J,K;
01200		FOR J←0 STEP 8 UNTIL 48 DO ⊂ OSTR("    ");
01300		FOR K←0 TO 7 DO ⊂ IF K=4∨K=2∨K=6 THEN OSTR(" ");
01400		IF X[I,J+K] THEN OSTR("Q") ELSE OSTR(".");⊃;⊃;
01500		OSTR(↓);
01600	END;
01700	
01800	SUBR PRINTX;
01900	BEGIN
02000		ITG I;
02100		FOR I←0 TO 7 DO PROW(I);
02200		OSTR(↓&↓&↓);
02300		X[0,0]←0;ARRBLT(X[0,1],X[0,0],64*8-1);
02400	END;
02500	
02600		OPEN(1,"DSK",8,3,0,0,0,0);
02700		LOOKUP(1,"QFILE",0);
02800		ARRYIN(1,Q[0],999);
02900		RELEASE(1);
03000	
03100		OPEN(2,"DSK",0,0,3,0,0,0);
03200		ENTER(2,"Q.LST",0);
     

00100	FOR PTR←1 TO 56 DO
00200	BEGIN
00300		QQ ← Q[PTR];
00400	R←(QQ LAND '70)LSH -3;C←QQ LAND '7;QQ←QQ LSH -6;X[R,C+COL]←-1;
00500	R←(QQ LAND '70)LSH -3;C←QQ LAND '7;QQ←QQ LSH -6;X[R,C+COL]←-1;
00600	R←(QQ LAND '70)LSH -3;C←QQ LAND '7;QQ←QQ LSH -6;X[R,C+COL]←-1;
00700	R←(QQ LAND '70)LSH -3;C←QQ LAND '7;QQ←QQ LSH -6;X[R,C+COL]←-1;
00800	R←(QQ LAND '70)LSH -3;C←QQ LAND '7;QQ←QQ LSH -6;X[R,C+COL]←-1;
00900		COL←COL+8;
01000	IF COL=56 THEN
01100	BEGIN COL←0;PRINTX;END;
01200	
01300	END;
01500		RELEASE(2);
01600	
01700	END;